home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
objtba.zip
/
MMGR.DOC
< prev
next >
Wrap
Text File
|
1993-01-04
|
36KB
|
907 lines
MMGR.PAS LISTING PAGE 1
PROGRAM MMGR;
{ *******************************************************************
Author: Thomas W. Harden
Version: 1.0
(C) 1990 Thomas W. Harden
All rights reserved
Demonstration program for Harden Consulting. Utilizes Copyrighted
program developement tools for DataBase manipulation, Menus, and
Data input/output forms. A relational data base is used with a
many to many relationship between the inities (Companies and Persons)
via a Third file (Contacts). This is the extent of the programing
required to implement this application.
******************************************************************* }
USES Crt,
Dos,
OopBase, { ObjectBase Compiled Unit. }
UserIO, { ObjectInterFace Module }
Windows, { " " }
Forms, { " " }
Fields, { " " }
Utility, { " " }
SysIntro, { Creates The First Screen Image. }
MMgrVar, { Unit containing Applications variables }
{ and initialization routines. }
MMgrRpts; { Unit containing Application specific }
{ report routines. }
PROCEDURE InitDB(Var D : DB);
{
This procedure is passed the Database variable and calls the the objects
initialization (D.Init), loads the Datafile information and indexfile
information, opens the database then sets up the first records to view.
Note the use of Constants for the FileNames. This makes it easier to
remember and write the proper term when searching for a file to SwitchTo.
}
BEGIN { InitDB }
D.Init;
D.LoadDataFile(New(DFilePtr,init(CompanyData,'',SizeOf(Company),
@Company)));
D.LoadIndexFile(New(IFilePtr,init(CompanySysNdx,'',SizeOf(Company.Code),
@Company.Code,0)),CompanyData);
D.LoadIndexFile(New(IFilePtr,init(CompanyUserNdx,'',SizeOf(Company.Alpha),
@Company.Alpha,1)),CompanyData);
D.LoadDataFile(New(DFilePtr,init(PersonData,'',SizeOf(Person),@Person)));
D.LoadIndexFile(New(IFilePtr,init(PersonSysNdx,'',SizeOf(Person.Code),
@Person.Code,0)),PersonData);
D.LoadIndexFile(New(IFilePtr,init(PersonUserNdx,'',SizeOf(Person.AlphaK),
@Person.AlphaK,1)),PersonData);
D.LoadDataFile(New(DFilePtr,init(ContactData,'',SizeOf(Contact),@Contact)));
D.LoadIndexFile(New(IFilePtr,init(ContactCompAccess,'',
SizeOf(Contact.Ckey),
@Contact.ckey,0)),ContactData);
MMGR.PAS LISTING PAGE 2
D.LoadIndexFile(New(IFilePtr,init(ContactPrsnAccess,'',
SizeOf(Contact.PKey),
@Contact.PKey,0)),ContactData);
D.Open;
D.SwitchTo(CompanyData); { Sets 'COMPANY.DAT' to primary file }
D.SetIndex(CompanyUserNdx); { Sets 'COMPALPH.NDX' as ordering Ndx }
D.Top; { Sets Company to the 1st alphabetic }
{ entry in file }
D.SwitchTo(PersonData); { Sets 'PERSON.DAT' to primary file }
D.SetIndex(PersonUserNdx); { Sets 'PRSNALPH.NDX' as ordering Ndx }
D.Top; { Sets Person to the 1st alphabetic }
{ entry in file }
END; { InitDB }
PROCEDURE CompanyMaint;
VAR
Choice,
Choice1 : Integer; { Menu selection variables }
Finished,
Finished1 : Boolean; { Loop Control variables }
Key : String;
Ch : Char; { Dummy receiver for pause }
BEGIN
{ Set up relations for viewing data from company perspective }
{ Company --> Contact --> Person }
{ code <-- --> code }
DBase.LoadRelation( CompanyData,ContactData,ContactCompAccess,
@Company.Code);
DBase.loadRelation( ContactData,PersonData,PersonSysNdx,
@Contact.personCode);
Choice := 0;
Finished := False;
PushHelp(ord(CompanyHelp)); { Sets context sinsitive help system}
DBase.Switchto(CompanyData);
DBase.SetIndex(CompanyUserNdx);
DBase.get;
DBase.Associate(CompanyData); { Sets Record variables to values based }
{ on the Relations just loaded }
CompForm.Show; { This an instance of the Form object }
REPEAT
CompForm.Leave; { Informs CompForm that it is inactive, }
{ Still visible. }
Choice := CompanyMenu.Pop; { Displays PopUp Menu and Returns Choice}
CompanyMenu.Hide; { Removes Menu From Screen }
Case Choice of
1: BEGIN { Record Edit }
PushHelp(ord(CompanyeditHelp)); { Sets help to Edit Help }
if Not DBase.Empty then
begin
compform.edit;
company.rcst.upstamp := timeStamp;
dbase.put;
end
else
MMGR.PAS LISTING PAGE 3
with EmptyFileMsg do { <-- EmptyFileMsg is a Message }
begin { object. }
show;
Ch := ReadKey;
hide;
end;
PopHelp; { Returns help to prevs state }
END; { Record Edit }
2: BEGIN { Find Record }
if Not DBase.Empty then
begin
PushHelp(ord(CompanyFindHelp));
Key := query('Enter Alpha Key of Company desired?',
Rpt('U',SizeOf(company.alpha)-1),
SizeOf(company.alpha)-1);
DBase.Search(Key);
DBase.Associate(CompanyData);
CompForm.show;
popHelp;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END; { Find Record }
3: BEGIN { Get Next Record }
if Not DBase.Empty then
begin
dbase.next; { Returns the next record in }
{ the primary file, orderd by}
{ the active index. }
DBase.Associate(CompanyData); { Aligns Dbase based on the }
{ the active relations }
compform.show;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
4: BEGIN
if Not DBase.Empty then
begin
dbase.Prev; { Returns the Prevs record in }
{ the primary file, orderd by }
{ the active index. }
DBase.Associate(CompanyData); { Aligns Dbase based on the }
{ the active relations }
compform.show;
end
MMGR.PAS LISTING PAGE 4
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END; { get Previous record }
5: BEGIN { Add a Company record }
PushHelp(ord(CompanyaddHelp));
dbase.blankrecord; { Initializes the Pimary Data Record }
DBase.Associate(CompanyData);
company.rcst.instamp := timeStamp;
company.code := nextcode(dbase.lastcode(companysysndx),
sizeof(company.code)-1);
compform.edit; { CompForm object will edit itself }
compform.leave;
company.rcst.upstamp := timeStamp;
if YesNo(concat('Do really want to add this record to ',
CompanyData,'?')) Then
dbase.add { yes add record to file }
ELSE
BEGIN { No reset file to prev state }
DBase.prev;
DBAse.Associate(CompanyData);
CompForm.show; { show reset data }
END;
PopHelp;
END; { Add Record }
6: BEGIN { Set Flag Field }
if Not DBase.Empty then
begin
Company.Flag := Not (Company.flag);
DBase.put;
CompForm.show;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
7: BEGIN { Add a Contact }
if Not DBase.Empty then
begin
PushHelp(ord(companycontacthelp));
DBase.Switchto(PersonData);
DBase.SetIndex(PersonUserNdx);
{ Get Person Key }
Key := '';
Key := Query('Enter last name of Contact->',
rpt('U',sizeof(person.LName)-2),
sizeof(Person.LName)-2);
{ Show located person record }
MMGR.PAS LISTING PAGE 5
DBase.Search(Key);
PrsnContForm.Show;
{ Get correct person record }
Finished1 := False;
REPEAT
PrsnContForm.Leave;
Choice1 := CompContMenu.Pop;
CompContMenu.Hide;
Case Choice1 of
1 : BEGIN { Correct }
if Not DBase.Empty then
begin
pushHelp(ord(Comp2PrsnAddHelp));
DBase.SwitchTo(ContactData);
DBAse.BlankRecord;
Contact.Position := Query(
Concat('Enter ',Person.FName,' ',Person.LName,
'''s position with ',Company.alpha,'->'),
rpt('W',sizeof(contact.Position)-1),
sizeof(Contact.Position)-1);
Contact.PersonCode := Person.Code;
Contact.CompanyCode := Company.Code;
Contact.PKey := Concat(Contact.PersonCode,
Contact.CompanyCode);
Contact.CKey := Concat(Contact.CompanyCode,
Contact.PersonCode);
dbase.setindex(ContactCompAccess);
if DBase.keyexist(contact.cKey) then
begin
RecordExists.show;
ch := Readkey;
RecordExists.hide;
end
else
DBase.add;
Finished1 := True;
PopHelp;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
2 : BEGIN { Next }
if Not DBase.Empty then
begin
DBase.Next;
PrsnContForm.show;
end
else
with EmptyFileMsg do
begin
show;
MMGR.PAS LISTING PAGE 6
Ch := ReadKey;
hide;
end;
END;
3 : BEGIN { Prev }
if Not DBase.Empty then
begin
DBase.Prev;
PrsnContForm.Show;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
4 : BEGIN { Add Person }
PushHelp(ord(PersonAddHelp));
dbase.blankrecord;
dbase.Switchto(contactdata);
dbase.blankrecord;
dbase.switchto(persondata);
Person.rcst.instamp := timeStamp;
Person.code := nextcode(dbase.lastcode(Personsysndx),
sizeof(Person.code)-1);
PersonForm.edit;
Person.rcst.upstamp := timeStamp;
Person.AlphaK := UpcaseStr(concat(copy(Person.LName,1,
sizeof(person.AlphaK)-2),
copy(person.fname,1,1)));
personform.leave;
if YesNo(concat('Do really want to add this record to ',
PersonData,'?')) Then
dbase.add
ELSE
DBAse.Associate(companyData);
PersonForm.Hide;
prsnContform.show;
popHelp;
END;
5 : Finished1 := True; { Abandon }
END;
UNTIL Finished1;
PrsnContForm.hide;
Dbase.SwitchTo(CompanyData);
DBase.SetIndex(CompanyUserNdx);
CompForm.Show;
PopHelp;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
MMGR.PAS LISTING PAGE 7
hide;
end;
END;
8: BEGIN { View Next Contact }
if Not DBase.Empty then
begin
DBase.NextAssoc(CompanyData);
CompForm.Show;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
9: BEGIN { Delete a Contact relationship }
if Not DBase.Empty then
begin
Finished1 := False;
REPEAT
PushHelp(ord(contactDel));
{ present menu of choices }
Choice1 := PersonContDelMenu.pop;
PersonContDelMenu.Hide;
Case Choice1 of
1 : BEGIN { Delete this one }
Dbase.Switchto(ContactData);
DBase.DelRec;
Dbase.SwitchTo(CompanyData);
Dbase.Associate(CompanyData);
CompForm.Show;
Finished1 := True;
END;
2 : BEGIN { Get Next Relation }
DBase.Nextassoc(PersonData);
CompForm.Show;
END;
3 : BEGIN { Abort }
finished1 := True;
END;
END;
Compform.leave;
UNTIL finished1;
PopHelp;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
10: Finished := True;
MMGR.PAS LISTING PAGE 8
END;
UNTIL Finished;
CompForm.Hide;
DBase.ClearRelations; { Removes set of relations loaded for }
{ this application. }
{ At this time there are no known }
{ relations }
PopHelp;
END;
PROCEDURE PersonMaint;
VAR
Choice,
Choice1 : Integer;
Finished,
Finished1 : Boolean;
Key : String;
Ch : Char;
BEGIN
Choice := 0;
Finished := False;
pushhelp(ord(personhelp));
{ Set up relations for this section of code. }
{ Person --> Contact --> Company }
{ Code <--/ \--> Code }
DBase.LoadRelation( PersonData,ContactData,ContactPrsnAccess,
@Person.Code);
DBase.loadRelation( ContactData,CompanyData,CompanySysNdx,
@Contact.CompanyCode);
DBase.Switchto(PersonData);
DBase.SetIndex(PersonUserNdx);
dbase.get;
DBase.Associate(PersonData);
PersonForm.Show;
REPEAT
PersonForm.Leave;
Choice := PersonMenu.Pop;
PersonMenu.Hide;
Case Choice of
1: BEGIN
if Not DBase.Empty then
begin
pushhelp(ord(PersonEdithelp));
PersonForm.edit;
Person.rcst.upstamp := timeStamp;
Person.AlphaK := UpcaseStr(concat(copy(Person.LName,1,
sizeof(person.AlphaK)-2),
copy(person.fname,1,1)));
dbase.Put;
pophelp;
end
else
with EmptyFileMsg do
begin
show;
MMGR.PAS LISTING PAGE 9
Ch := ReadKey;
hide;
end;
END;
2: BEGIN
if Not DBase.Empty then
begin
pushhelp(ord(Personfindhelp));
Key := query('Enter Last Name of Individual desired?',
rpt('U',sizeof(Person.LName)-2),
sizeof(Person.LName)-2);
DBase.Search(Key);
DBase.Associate(PersonData);
PersonForm.show;
pophelp;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
3: BEGIN
if Not DBase.Empty then
begin
dbase.next; { Returns the Next record in }
{ the primary file, orderd by }
{ the active index. }
DBase.Associate(PersonData); { Aligns Dbase based on the }
{ the active relations }
PersonForm.show;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
4: BEGIN
if Not DBase.Empty then
begin
dbase.Prev; { Returns the Prevs record in }
{ the primary file, orderd by }
{ the active index. }
DBase.Associate(PersonData); { Aligns Dbase based on the }
{ the active relations }
PersonForm.show;
end
else
with EmptyFileMsg do
begin
show;
MMGR.PAS LISTING PAGE 10
Ch := ReadKey;
hide;
end;
END;
5: BEGIN
PushHelp(ord(PersonAddHelp));
dbase.blankrecord;
DBase.associate(PersonData);
Person.rcst.instamp := timeStamp;
Person.code := nextcode(dbase.lastcode(Personsysndx),
sizeof(Person.code)-1);
PersonForm.edit;
PersonForm.Leave;
Person.rcst.upstamp := timeStamp;
Person.AlphaK := UpcaseStr(concat(copy(Person.LName,1,
sizeof(person.AlphaK)-2),
copy(person.fname,1,1)));
if YesNo(concat('Do really want to add this record to ',
PersonData,'?')) Then
dbase.add
ELSE
BEGIN
DBase.get;
DBAse.Associate(PersonData);
PersonForm.show;
END;
PopHelp;
END;
6: BEGIN
if Not DBase.Empty then
begin
Person.Flag := Not (Person.Flag);
Dbase.put;
PersonForm.show;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
7: BEGIN
if Not DBase.Empty then
begin
PushHelp(Ord(PersonContactHelp));
DBase.Switchto(companyData);
DBase.SetIndex(companyUserNdx);
{ Get company Key }
Key := '';
Key := Query('Enter Company AlphaKey->',
rpt('U',sizeof(Company.alpha)-1),
sizeof(company.alpha)-1);
{ Show located company record }
DBase.Search(Key);
MMGR.PAS LISTING PAGE 11
CompContForm.Show;
{ Get correct company record }
Finished1 := False;
REPEAT
CompContForm.Leave;
Choice1 := PrsnContMenu.Pop;
PrsnContMenu.Hide;
Case Choice1 of
1 : BEGIN { Correct }
if Not DBase.Empty then
begin
PushHelp(Ord(Prsn2CompAddHelp));
DBase.SwitchTo(ContactData);
DBAse.BlankRecord;
Contact.Position := Query(
Concat('Enter ',Person.FName,' ',Person.LName,
'''s position with ',Company.Alpha,'->'),
rpt('W',sizeof(contact.Position)-1),
sizeof(Contact.Position)-1);
Contact.PersonCode := Person.Code;
Contact.CompanyCode := Company.Code;
Contact.PKey := Concat(Contact.PersonCode,
Contact.CompanyCode);
Contact.CKey := Concat(Contact.CompanyCode,
Contact.PersonCode);
dbase.setindex(ContactPrsnAccess);
if DBase.keyexist(contact.PKey) then
begin
RecordExists.show;
ch := Readkey;
RecordExists.hide;
end
else
DBase.Add;
Finished1 := True;
popHelp;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
2 : BEGIN { Next }
if Not DBase.Empty then
begin
DBase.Next;
CompContForm.show;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
MMGR.PAS LISTING PAGE 12
hide;
end;
END;
3 : BEGIN { Prev }
if Not DBase.Empty then
begin
DBase.Prev;
CompContForm.Show;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
4 : BEGIN { Add company }
PushHelp(ord(CompanyAddhelp));
dbase.blankrecord;
dbase.Switchto(contactdata);
dbase.blankrecord;
dbase.switchto(companydata);
company.rcst.instamp := timeStamp;
company.code := nextcode(dbase.lastcode(companysysndx),
sizeof(company.code)-1);
compForm.edit;
company.rcst.upstamp := timeStamp;
Compform.leave;
if YesNo(concat('Do really want to add this record to ',
CompanyData,'?')) Then
dbase.add
ELSE
DBAse.Associate(PersonData);
CompForm.Hide;
CompContform.show;
popHelp;
END;
5 : Finished1 := True; { Abandon }
END;
UNTIL Finished1;
CompContForm.hide;
Dbase.SwitchTo(CompanyData);
DBase.SetIndex(CompanyUserNdx);
PersonForm.Show;
PopHelp;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
8: BEGIN
MMGR.PAS LISTING PAGE 13
if Not DBase.Empty then
begin
DBase.NextAssoc(PersonData);
PersonForm.Show;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
9: BEGIN
if Not DBase.Empty then
begin
Finished1 := False;
REPEAT
{ present menu of choices }
Choice1 := PersonContDelMenu.pop;
PersonContDelMenu.Hide;
Case Choice1 of
1 : BEGIN { Delete this one }
Dbase.Switchto(ContactData);
DBase.DelRec;
Dbase.SwitchTo(PersonData);
Dbase.Associate(PersonData);
PersonForm.Show;
Finished1 := True;
END;
2 : BEGIN { Get Next Relation }
DBase.Nextassoc(PersonData);
PersonForm.Show;
END;
3 : BEGIN { Abort }
finished1 := True;
END;
END;
Personform.leave;
UNTIL finished1;
end
else
with EmptyFileMsg do
begin
show;
Ch := ReadKey;
hide;
end;
END;
10: Finished := True;
END;
UNTIL Finished;
PersonForm.Hide;
DBase.ClearRelations; { Removes set of relations loaded for }
{ this application. }
{ At this time there are no known }
MMGR.PAS LISTING PAGE 14
{ relations }
popHelp;
END;
Procedure reports;
{ Calls routines found in MMGRRPTS.PAS }
var
choice : integer;
Finished : Boolean;
begin
pushhelp(ord(reporthelp));
Finished := False;
Repeat
Choice := ReportMenu.Pop;
ReportMenu.Leave;
CASE Choice of
1 : MailLabels;
2 : CompanyReports;
3 : ContactReports;
4 : Finished := True;
End;
Until Finished;
ReportMenu.Hide;
pophelp;
end;
Procedure Utilities;
var Choice : integer;
Finished : boolean;
DBSaveMsg: message;
begin
PushHelp(ord(UtilHelp));
Finished := False;
Repeat
choice := utilMenu.pop;
UtilMenu.leave;
case choice of
1 : Begin
PushHelp(ord(ColorHelp));
Set_Colors; { ObjectInterFace - User can set }
{ colors to any value he wants }
PopHelp;
end;
2 : Begin
DbSaveMsg.init(
'Saving Data and Index files to disk. Please be Patient.');
Dbsavemsg.show;
DBase.Save;
dbsavemsg.done;
end;
3 : finished := true;
end
Until finished;
UtilMenu.hide;
MMGR.PAS LISTING PAGE 15
PopHelp;
end;
{$F+}
PROCEDURE MyExitProc;
{ This is done to insure that the data files are closed should a }
{ problem occur and program is prematurly terminated. }
BEGIN { MyExitProc }
ExitProc := SysExit;
dbclosemsg.show;
DBase.Close;
dbclosemsg.hide;
textmode(OldMode);
DBase.Done;
END; { MyExitProc }
{$F-}
BEGIN { Main }
{ Set up for Exit Code }
SysExit := ExitProc;
ExitProc:= @MyExitProc;
{ Save current video mode }
OldMode := LastMode;
InitHelp(HelpFileName); { Part of the ObjectInterFace }
PushHelp(Ord(OverView));
InitMsgs;
Introduction;
dbloadMsg.show; { Message object method (ObjectInterFace) - displays }
{ Text passed when object was initialized. }
dbloadmsg.leave; { Message Object method (ObjectInterFace) - DeActivates }
{ the Message window but leaves it visible. (Lets }
{ program address other portions of the screen.) }
Initdb(DBase); { Loads Data and Index Files into Dbase, opens files,}
{ and sets record variables to first alphabetic record}
InitMenus; { Defines the Menus used in program MMGRVARS.PAS }
InitForms; { Defines the Forms used in program MMGRVARS.PAS }
dbloadmsg.hide; { Message object method (ObjectInterFace) - Restores }
{ Screen to state previous to show call. }
Finished := False;
REPEAT
Pushhelp(Ord(MMhelp));{ Sets helpdata to MainMenu date(ObjectInterFace)}
choice := MainMenu.pop;{ Shows and returns user selection from MainMenu}
{ Menu Object(ObjectInterface) }
mainmenu.hide; { Removes Menu from screen. }
case choice of
1 : CompanyMaint;
2 : PersonMaint;
3 : Reports;
4 : Utilities;
5 : Finished := YesNo('Do you really want to leave program?');
END;
UNTIL Finished;
PopHelp;
{ Remember exit code will execute at this time or any time the program is }
{ terminated. }
MMGR.PAS LISTING PAGE 16
END. { program }
